home *** CD-ROM | disk | FTP | other *** search
/ GFX Sensations 1 / Graphic Sensations - Volume 1.iso / com_net / tcp / amitcp-demo / extutil / mg-mouse.el next >
Lisp/Scheme  |  2000-01-01  |  9KB  |  277 lines
  1. ;;;
  2. ;;; This Emacs lisp mode can be used with Napsaterm 3 
  3. ;;;                            //ppessi
  4. ;;;
  5. ;;; mg-mouse.el
  6. ;;; Mic Kaczmarczik (mic@emx.cc.utexas.edu)
  7. ;;; 07-Sep-1987
  8. ;;;
  9. ;;; Modifications:
  10. ;;;    11-Sep-1987 MPK        Remember last mouse click in order to set
  11. ;;;                the mark if you click twice on same spot.
  12. ;;;                Implement mg-mouse-set-mark-and-kill to be
  13. ;;;                more intuitive (thanks, Mike)
  14. ;;;
  15. ;;;    20-Sep-1987 MPK        Put gadgets in left hand side of mode line
  16. ;;;    19-Jun-1989 MWM        Take gadgets out of mode line
  17. ;;;
  18. ;;; Makes Emacs respond to mouse click input, based on Mike Meyer's hack
  19. ;;; to VT100 2.6 and x-mouse.el.  Things work like the hot mouse in mg
  20. ;;; (formerly known as MicroGNUEmacs) -- you get different results,
  21. ;;; depending on whether you click on the text in a window, a mode line,
  22. ;;; or the minibuffer down at the bottom of the screen.  See the
  23. ;;; documentation string for mg-mouse-command for the default bindings.
  24. ;;;
  25. ;;; This code doesn't need the GNU X-windows code to work, which Mike's
  26. ;;; original amiga-mouse code did.  Thanks to Mike for the inspiration
  27. ;;; and his documentation (which I have shamelessly quoted from in places).
  28. ;;;
  29. ;;; I'm looking for an easier way for users to rebind what happens when
  30. ;;; they click in a particular area.  Right now you have to manually
  31. ;;; change an a-list, but there's *got* to be a better way.  Oh well, at
  32. ;;; least it works :-)
  33. ;;;
  34. ;;; VT100 mouse hack format:
  35. ;;; 
  36. ;;;    <ESC> M (yes, a real capital M) quals column line
  37. ;;;
  38. ;;; column and line are bytes that just hold the column/line number,
  39. ;;; zero-based and offset by 32. quals is like so:
  40. ;;;
  41. ;;;    bit 0    control key
  42. ;;;    bit 1    shift key
  43. ;;;    bit 2    meta (alt) key
  44. ;;;    bit 3    caps lock
  45. ;;;    bit 4    mouse down event
  46. ;;;    bit 5    mouse up event
  47. ;;;
  48. ;;; Quals is offset by 64, so a shifted downward mouse click on row 1,
  49. ;;; column 1 results in the escape sequence
  50. ;;;    <ESC> M R <SPC> <SPC>
  51. ;;;
  52.  
  53. ;;; 
  54. ;;; Qualifier bit definitions
  55. ;;;
  56.  
  57. (defconst mg-mouse-vanilla 0)
  58. (defconst mg-mouse-ctrl 1)
  59. (defconst mg-mouse-shift 2)
  60. (defconst mg-mouse-ctrl-shift 3)
  61. (defconst mg-mouse-alt 4)
  62. (defconst mg-mouse-ctrl-alt 5)
  63. (defconst mg-mouse-shift-alt 6)
  64. (defconst mg-mouse-ctrl-shift-alt 7)
  65. (defconst mg-mouse-qual-mask 15)
  66.  
  67. (defconst mg-mouse-capslock 8)
  68. (defconst mg-mouse-select-down 16)
  69. (defconst mg-mouse-select-up 32)
  70.  
  71. ;;;
  72. ;;; Actions to take when the mouse is clicked.  When you click in
  73. ;;; the window, mg-mouse-command moves point to where you clicked,
  74. ;;; then calls the action routine as an interactive command.  You can
  75. ;;; rebind these functions by prepending items to the a-list. (Is
  76. ;;; there a better way to do this?)
  77. ;;;
  78.  
  79. (defvar mg-mouse-previous-click nil
  80.   "(x, y) position of next-to-last mouse click")
  81.  
  82. (defvar mg-mouse-click nil
  83.   "(x, y) position of last mouse click")
  84.  
  85. (defvar mg-mouse-last-point nil
  86.   "Position of point just before mg-mouse-set-point moved it.")
  87.  
  88. ;;;
  89. ;;; Things to do...
  90. ;;;
  91.  
  92. (defvar mg-mouse-window-actions nil
  93.    "A-list of functions to call when the mouse is clicked in an Emacs window.")
  94.  
  95. (setq mg-mouse-window-actions
  96.       (list
  97.        (cons mg-mouse-vanilla        'mg-mouse-maybe-set-mark)
  98.        (cons mg-mouse-shift        'top-and-redisplay)
  99.        (cons mg-mouse-ctrl        'delete-char)
  100.        (cons mg-mouse-ctrl-shift    'delete-horizontal-space)
  101.        (cons mg-mouse-alt        'kill-word)
  102.        (cons mg-mouse-shift-alt        'kill-line)
  103.        (cons mg-mouse-ctrl-alt        'mg-mouse-set-mark-and-kill)
  104.        (cons mg-mouse-ctrl-shift-alt    'yank)))
  105.  
  106. ;;;
  107. ;;; Things to do when you click on the mode line of a window.  The
  108. ;;; window is selected, then the function is called interactively.
  109. ;;;
  110.  
  111. (defvar mg-mouse-mode-actions nil
  112.    "A-list of functions to call when the mouse is clicked in a mode line.")
  113.  
  114. (setq mg-mouse-mode-actions
  115.       (list
  116.        (cons mg-mouse-vanilla        'mg-mouse-vanilla-mode-line)
  117.        (cons mg-mouse-shift        'mg-mouse-shift-mode-line)
  118.        (cons mg-mouse-ctrl        'beginning-of-buffer)
  119.        (cons mg-mouse-ctrl-shift    'end-of-buffer)
  120.        (cons mg-mouse-alt        'split-window)
  121.        (cons mg-mouse-shift-alt        'delete-window)
  122.        (cons mg-mouse-ctrl-alt        'enlarge-window)
  123.        (cons mg-mouse-ctrl-shift-alt    'shrink-window)))
  124.  
  125. ;;;
  126. ;;; Things to do when you click in the echo line.
  127. ;;;
  128.  
  129. (defvar mg-mouse-echo-actions nil
  130.    "A-list of functions to call when the mouse is clicked in the minibuffer")
  131.  
  132. (setq mg-mouse-echo-actions
  133.       (list
  134.        (cons mg-mouse-vanilla        'save-buffer)
  135.        (cons mg-mouse-shift        'kill-buffer)
  136.        (cons mg-mouse-ctrl        'suspend-emacs)
  137.        (cons mg-mouse-ctrl-shift    'save-buffers-kill-emacs)
  138.        (cons mg-mouse-alt        'describe-key)
  139.        (cons mg-mouse-shift-alt        'describe-bindings)
  140.        (cons mg-mouse-ctrl-alt        'list-buffers)
  141.        (cons mg-mouse-ctrl-shift-alt    'buffer-menu)))
  142.  
  143. ;;;
  144. ;;; Handle the user's mouse click.  We only pay attention to when
  145. ;;; the mouse button is pressed, not when it is released.
  146. ;;;
  147.  
  148. (defun mg-mouse-command ()
  149. "Interpret Amiga mouse clicks from the VT100 program.  The bindings are:
  150.  
  151.  Qualifiers  |            Area clicked
  152.              |
  153. C  A  Shift  |    Text window        Mode line    Echo line
  154. -------------+---------------------------------------------------------
  155.          |    dot to mouse        forward page    switch to buffer 
  156.       X         |    recenter        back page    kill buffer
  157.    X         |    delete word        split window    describe key
  158.    X  X         |    kill line        delete window    describe bindings
  159. X         |    delete char        goto bob    suspend emacs
  160. X     X      |    delete whitespace    goto eob    save buffers kill emacs
  161. X  X         |    kill region        enlarge window    list buffers
  162. X  X  X         |    yank            shrink window    buffer menu
  163.  
  164. Notice that the Status and Echo groups come in pairs; the shifted
  165. version of a key is in some sense the opposite of the unshifted version.
  166.  
  167. There is no opposite for display buffers, so that key is bound to
  168. buffer-menu (it's bound to an Amiga-specific function in Amiga mg).
  169. "
  170.   (interactive)
  171.   (let* ((qual (- (read-char) 64))        ;; read the qualifier,
  172.      (x (- (read-char) 32))            ;; x & y sequentially
  173.      (y (- (read-char ) 32))
  174.      (click nil)
  175.      (actions nil)
  176.      (action-routine nil))
  177.  
  178.     (if (not (zerop (logand qual mg-mouse-select-down)))
  179.     (progn
  180.       (setq click (mg-mouse-select-and-examine (list x y)))
  181.       (setq qual (logand qual mg-mouse-qual-mask))
  182.  
  183.       ;; get a-list of action routines based on where the click was
  184.       (if (not click)
  185.           (setq actions mg-mouse-echo-actions)    ;; no window
  186.         (if (eq (car click) 'mode-line)
  187.         (setq actions mg-mouse-mode-actions)    ;; mode line
  188.           (progn
  189.         (mg-mouse-set-point (cdr click))    ;; in text area
  190.         (setq actions mg-mouse-window-actions))))
  191.  
  192.       (setq mg-mouse-previous-click mg-mouse-click)
  193.       (setq mg-mouse-click (cdr click))
  194.  
  195.       ;; function to call? do it.
  196.       (if (setq action-routine (cdr (assoc qual actions)))
  197.           (call-interactively action-routine))))))
  198.       
  199. (defun mg-mouse-set-point (arg)
  200.   "Select Emacs window mouse is on, and move point to mouse position."
  201.   (let* ((rel-x (car arg))
  202.      (rel-y (car (cdr arg))))
  203.  
  204.     (setq mg-mouse-last-point (point))
  205.     (move-to-window-line rel-y)
  206.     (move-to-column (+ rel-x (current-column)))))
  207.  
  208. (defun mg-mouse-select-and-examine (arg)
  209.   "Select Emacs window the mouse is on, returning a triplet signifying
  210.    information about where exactly the click took place."
  211.   (let ((start-w (selected-window))
  212.     (done nil)
  213.     (where nil)
  214.     (w (selected-window))
  215.     (mouse-click-data nil))
  216.     (while (and (not done)
  217.         (null (setq mouse-click-data
  218.                 (mg-coordinates-in-window-p arg w))))
  219.       (setq w (next-window w))
  220.       (if (eq w start-w)
  221.       (setq done t)))
  222.     (select-window w)
  223.     mouse-click-data))
  224.  
  225. (defun mg-coordinates-in-window-p (pos w)
  226.   "Checks coordinate pair POS to see if it falls within window W.
  227. If the pair is inside the window, returns a list in the format
  228. (WHERE REL-X REL-Y), where WHERE is either 'mode-line or
  229. 'inside-window, and REL-X and REL-Y denote the click's coordinates
  230. relative to the window's origin."
  231.  
  232.   (let* ((edges (window-edges w))
  233.      (wl (nth 0 edges)) (wt (nth 1 edges))
  234.      (wr (nth 2 edges)) (wb (nth 3 edges))
  235.      (x (nth 0 pos))    (y (nth 1 pos)))
  236.     (if (and (and (>= x wl) (< x wr))
  237.          (and (>= y wt) (< y wb)))
  238.     (list (if (= y (1- wb))
  239.           'mode-line 'inside)
  240.           (- x wl) (- y wt))
  241.       nil)))
  242.  
  243. ;;;
  244. ;;; Command functions for special things.  These are commands so we can
  245. ;;; use call-interactively uniformly.
  246. ;;;
  247.  
  248. (defun mg-mouse-vanilla-mode-line nil
  249.   "Do a vanilla mode line click: scroll up one page"
  250.   (interactive)
  251.   (scroll-up))
  252.  
  253. (defun mg-mouse-shift-mode-line nil
  254.   "Do a shifted mode line click: scroll down one page"
  255.   (interactive)
  256.   (scroll-down))
  257.  
  258. (defun mg-mouse-maybe-set-mark nil
  259.   "Set point if the current and previous clicks in a window were in the
  260. same spot.  This is somewhat naive but usually sufficient :-)."
  261.   (interactive)
  262.   (if (equal mg-mouse-previous-click mg-mouse-click)
  263.       (call-interactively 'set-mark-command)))
  264.  
  265. (defun mg-mouse-set-mark-and-kill nil
  266.   "Set mark at old point, set point at where you clicked, then kill the region"
  267.   (interactive)
  268.   (set-mark mg-mouse-last-point)
  269.   (kill-region mg-mouse-last-point (point)))
  270.  
  271. ;;;
  272. ;;; Set up to react to the mouse "key"
  273. ;;;
  274.  
  275. (global-set-key "\eM" 'mg-mouse-command)
  276.  
  277. (provide 'mg-mouse)